home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-08-21 | 36.9 KB | 1,000 lines |
- MODULE Test;
-
- (*
- IntuiSup library DEMO
-
- Para usar con Modula-2 Software Construction Set
- -----------------------------------------------------------------------
-
- por: Mauricio Hunt R.
- Apt 856 - 2150, Moravia,
- San Jose, Costa Rica
- Central America
-
- -----------------------------------------------------------------------
-
- Intuisup library por:
-
- Torsten Jürgeleit
- Am Sandberg 4
- W-5270 Gummersbach
- Germany
-
- Gracias Torsten !
- *)
-
- FROM SYSTEM IMPORT ADR, BYTE, ADDRESS, TSIZE;
- FROM Intuition IMPORT WindowPtr, NewWindow, IDCMPFlags, IDCMPFlagsSet,
- WindowFlags, WindowFlagsSet, WBenchScreen,
- SmartRefresh, Image, CloseWindow, IntuiMessagePtr,
- MENUNUM, ITEMNUM, SUBNUM, MenuNull, NoMenu, NoItem,
- NoSub, MenuItemPtr, GadgetPtr;
- FROM Libraries IMPORT OpenLibrary, CloseLibrary;
- FROM Rasters IMPORT RastPortPtr;
- FROM Ports IMPORT MsgPortPtr, WaitPort;
- FROM Text IMPORT TextAttr, NormalFontStyle, FontFlags,
- FontFlagsSet;
- FROM Memory IMPORT MemReqSet, MemChip, MemPublic, MemClear,AllocMem,
- FreeMem;
- FROM Lists IMPORT ListPtr, List, NewList, AddTail, RemHead;
- FROM Nodes IMPORT NodePtr, Node;
- FROM Preferences IMPORT TopazEighty, TopazSixty;
- FROM FormatString IMPORT FormatArg;
- FROM CPrintBuffer IMPORT sprintf;
- FROM IntuiSupInterface IMPORT InitIntuiSupLib, CloseIntuiSupLib, IntuiSupBase,
- IntuiSupName, IntuiSupVersion,
-
- GadgetData,
- GadgetIDCMPFlagsAll, GadgetDataFlagDisabled,
- GadgetDataFlagHotKey, GadgetDataFlagTextColor2,
- GadgetDataFlagButtonToggle,
- GadgetDataFlagButtonImage, GadgetDataFlagNoBorder,
- GadgetDataFlagTextRight, GadgetDataFlagTextLeft,
- GadgetDataFlagInputAutoActive,
- GadgetDataFlagOrientationVert,
- GadgetDataFlagMovePointer,
- GadgetDataFlagListViewShowSelected,
- GadgetDataFlagTextBelow, GadgetDataFlagTextAbove,
-
- GadgetDataTypeButton,
- GadgetDataTypeCheck,GadgetDataTypeMx,
- GadgetDataTypeString, GadgetDataTypeInteger,
- GadgetDataTypeSlider, GadgetDataTypeScroller,
- GadgetDataTypeCycle, GadgetDataTypeCount,
- GadgetDataTypeListView, GadgetDataTypePalette,
-
- RenderInfoFlagInnerWindow, RenderInfoFlagBackFill,
- OpenWindowFlagCenterWindow,
- IntuiSupDataEnd,
-
- BorderData,
- BorderDataTypeBox2Out,
-
- MenuData,
- MenuDataTypeTitle, MenuDataTypeItem,
- MenuDataTypeSubItem,
-
- MenuDataFlagAtributte, MenuDataFlagSelected,
- MenuDataFlagHighBox, MenuDataFlagEmptyLine,
-
- TextData,
- TextDataTypeText,TextDataFlagCenter,
- TextDataFlagBold, TextDataFlagItalic,
- TextDataFlagUnderLined,
- TextDataFlagColor2,UseCurrentValue,
-
- AutoReqFlagBackFill, AutoReqFlagTextCenter,
- AutoReqFlagTextColor2, AutoReqFlagHotKey,
- AutoReqFlagMovePointerNeg,
-
- RequesterData,
- ReqDataFlagBackFill,
- ReqDataFlagInnerWindow,
-
- IGetRenderInfo, IFreeRenderInfo, IOpenWindow,
- ICreateGadgets, IFreeGadgets, ICreateMenu,
- IFreeMenu, IDisplayGadgets, IAttachMenu, ISupID,
- IRemoveMenu, IRemoveGadgets, IGetMsg, IReplyMsg,
- IClearRenderWindow, IPrintText,
- IAutoRequest, IDisplayRequester, IRemoveRequester,
- ISetGadgetAttributes, IMenuItemAddress;
-
- CONST
- WindowWidth = 600;
- WindowHeight = 200;
- WindowTitle = " Library Test ";
- WindowIDCMPflags = IDCMPFlagsSet{Closewindow, MenuPick}+GadgetIDCMPFlagsAll;
- Windowflags = WindowFlagsSet{WindowClose, WindowDrag, WindowDepth,
- Activate,NoCareRefresh}+SmartRefresh;
-
- RenderInfoFlags = RenderInfoFlagInnerWindow + RenderInfoFlagBackFill;
- OpenWindowFlags = OpenWindowFlagCenterWindow;
-
- MessageLeftEdge = 0;
- MessageTopEdge = 179; (* (WindowHeight - MessageHeight - 10) *)
- MessageWidth = WindowWidth;
- MessageHeight = 8;
- MessageText1 = "Gadget %d text %s";
- MessageText2 = "Gadget %d value %ld";
- MessageText3 = " Menu no. %d menu item no. %d sub item no. %d selected";
-
- VAR
- testnewwindow:NewWindow;
- topaz60attr, topaz80attr: TextAttr;
- testgadgetdata:ARRAY [0..14] OF GadgetData;
-
- test2textdata : ARRAY [0..4] OF TextData;
- test2borderdata : ARRAY [0..1] OF BorderData;
- test2gadgetdata : ARRAY [0..1] OF GadgetData;
- test2requesterdata:RequesterData;
-
- image1data,image2data:POINTER TO ARRAY [0..15] OF CARDINAL;
- image1,image2:Image;
- mxarray: ARRAY [0..3] OF ADDRESS;
- textarray : ARRAY [0..8] OF ADDRESS;
- testlist:List;
- testmenudata:ARRAY [0..17] OF MenuData;
-
- CONST
- TestGadgetButton = 0;
- TestGadgetButtonImage = 1;
- TestGadgetCheck = 2;
- TestGadgetMx = 3;
- TestGadgetString = 4;
- TestGadgetInteger = 5;
- TestGadgetSliderHoriz = 6;
- TestGadgetSliderVert = 7;
- TestGadgetScrollerHoriz = 8;
- TestGadgetScrollerVert = 9;
- TestGadgetCycle = 10;
- TestGadgetCount = 11;
- TestGadgetListView = 12;
- TestGadgetPalette = 13;
-
- TestGadget1Type = GadgetDataTypeButton;
- TestGadget1Flags = GadgetDataFlagHotKey+GadgetDataFlagTextColor2;
- TestGadget1LeftEdge = 20;
- TestGadget1TopEdge = 10;
- TestGadget1Width = ((6 + 2) * 10);
- TestGadget1Height = 19;
- TestGadget1Text = "_Button";
-
- TestGadget2Type = GadgetDataTypeButton;
- TestGadget2Flags = GadgetDataFlagButtonToggle+GadgetDataFlagButtonImage+
- GadgetDataFlagNoBorder+GadgetDataFlagHotKey+
- GadgetDataFlagTextRight+GadgetDataFlagTextColor2;
- TestGadget2LeftEdge = 120;
- TestGadget2TopEdge = 15;
- TestGadget2Width = 16;
- TestGadget2Height = 8;
- TestGadget2Text = "_Image";
-
- TestGadget3Type = GadgetDataTypeCheck;
- TestGadget3Flags = GadgetDataFlagHotKey + GadgetDataFlagTextRight;
- TestGadget3LeftEdge = 20;
- TestGadget3TopEdge = 35;
- TestGadget3Width = 0;
- TestGadget3Height = 0;
- TestGadget3Text = "_Check Gadget";
- TestGadget3CheckState = 1;
-
- TestGadget4Type = GadgetDataTypeMx;
- TestGadget4Flags = GadgetDataFlagHotKey+GadgetDataFlagTextLeft+
- GadgetDataFlagTextColor2;
- TestGadget4LeftEdge = 20;
- TestGadget4TopEdge = 65;
- TestGadget4Width = 0;
- TestGadget4Height = 0;
- TestGadget4Text = "Mutual E_xclude gadget";
- TestGadget4Spacing = 2;
- TestGadget4Active = 1;
-
- TestGadget5Type = GadgetDataTypeString;
- TestGadget5Flags = GadgetDataFlagHotKey+GadgetDataFlagInputAutoActive+
- GadgetDataFlagTextRight;
- TestGadget5LeftEdge = 20;
- TestGadget5TopEdge = 112;
- TestGadget5Width = 68;
- TestGadget5Height = 0;
- TestGadget5Text = "_String Gadget";
- TestGadget5InputLen = 10;
- TestGadget5AutoActive = (5D*65536D)+5D;
- TestGadget5InputDefault = "Test";
-
- TestGadget6Type = GadgetDataTypeInteger;
- TestGadget6Flags = GadgetDataFlagHotKey+
- GadgetDataFlagInputAutoActive+
- GadgetDataFlagTextLeft+GadgetDataFlagTextColor2;
- TestGadget6LeftEdge = (20 + 14 * 10 + 8);
- TestGadget6TopEdge = 130;
- TestGadget6Width = 68;
- TestGadget6Height = 0;
- TestGadget6Text = "I_nteger gadget";
- TestGadget6InputLen = 10;
- TestGadget6AutoActive = (4D*65536D)+4D;
-
- TestGadget7Type = GadgetDataTypeSlider;
- TestGadget7Flags = GadgetDataFlagHotKey + GadgetDataFlagTextRight;
- TestGadget7LeftEdge = 20;
- TestGadget7TopEdge = 150;
- TestGadget7Width = 100;
- TestGadget7Height = 9;
- TestGadget7Text = "S_lider gadget";
- TestGadget7Min = -10;
- TestGadget7Max = 10;
- TestGadget7Level = 0;
-
- TestGadget8Type = GadgetDataTypeSlider;
- TestGadget8Flags = GadgetDataFlagHotKey+GadgetDataFlagOrientationVert+
- GadgetDataFlagTextBelow;
- TestGadget8LeftEdge = 390;
- TestGadget8TopEdge = 10;
- TestGadget8Width = 18;
- TestGadget8Height = 50;
- TestGadget8Text = "Sli_der gadget";
- TestGadget8Min = -10;
- TestGadget8Max = 10;
- TestGadget8Level = 0;
-
- TestGadget9Type = GadgetDataTypeScroller;
- TestGadget9Flags = GadgetDataFlagHotKey+GadgetDataFlagTextLeft+
- GadgetDataFlagTextColor2;
- TestGadget9LeftEdge = (20 + 15 * 10 + 8);
- TestGadget9TopEdge = 165;
- TestGadget9Width = 100;
- TestGadget9Height = 0;
- TestGadget9Text = "Scr_oller gadget";
- TestGadget9Visible = 4D;
- TestGadget9Total = 20D;
- TestGadget9Top = 10D;
-
- TestGadget10Type = GadgetDataTypeScroller;
- TestGadget10Flags = GadgetDataFlagHotKey+GadgetDataFlagOrientationVert+
- GadgetDataFlagTextAbove;
- TestGadget10LeftEdge = 490;
- TestGadget10TopEdge = 20;
- TestGadget10Width = 0;
- TestGadget10Height = 50;
- TestGadget10Text = "Sc_roller gadget";
- TestGadget10Visible = 4;
- TestGadget10Total = 20;
- TestGadget10Top = 10;
-
- TestGadget11Type = GadgetDataTypeCycle;
- TestGadget11Flags = GadgetDataFlagHotKey+GadgetDataFlagTextRight+
- GadgetDataFlagTextColor2;
- TestGadget11LeftEdge = 265;
- TestGadget11TopEdge = 80;
- TestGadget11Width = 160;
- TestGadget11Height = 19;
- TestGadget11Text = "C_ycle gadget";
- TestGadget11Active = 2;
-
- TestGadget12Type = GadgetDataTypeCount;
- TestGadget12Flags = GadgetDataFlagHotKey+GadgetDataFlagTextRight;
- TestGadget12LeftEdge = 325;
- TestGadget12TopEdge = 110;
- TestGadget12Width = 80;
- TestGadget12Height = 12;
- TestGadget12Text = "Co_unt gadget";
- TestGadget12Min = 100;
- TestGadget12Max = 1000;
- TestGadget12Value = 600;
-
- TestGadget13Type = GadgetDataTypeListView;
- TestGadget13Flags = GadgetDataFlagHotKey+GadgetDataFlagTextColor2
- +GadgetDataFlagListViewShowSelected;
- TestGadget13LeftEdge = 370;
- TestGadget13TopEdge = 144;
- TestGadget13Width = 104;
- TestGadget13Height = 35;
- TestGadget13Text = "List _view gadget";
- TestGadget13Spacing = 0;
- TestGadget13Top = 1;
-
- TestGadget14Type = GadgetDataTypePalette;
- TestGadget14Flags = GadgetDataFlagHotKey + GadgetDataFlagTextColor2;
- TestGadget14LeftEdge = 220;
- TestGadget14TopEdge = 23;
- TestGadget14Width = 150;
- TestGadget14Height = 25;
- TestGadget14Text = "_Palette gadget";
- TestGadget14Depth = 2;
- TestGadget14ColorOffset = 0;
- TestGadget14ActiveColor = 0;
-
- Test1AutoReqTitle = " Auto Request ";
- Test1AutoReqBodyText = "Test line 1\\n\\nTest line 2\\nTest line 3\\n\\nTest line 4";
- Test1AutoReqPosText = "_Positive";
- Test1AutoReqNegText = "_Negative";
- Test1AutoReqFlags = AutoReqFlagBackFill+AutoReqFlagTextCenter+
- AutoReqFlagTextColor2+AutoReqFlagHotKey+
- AutoReqFlagMovePointerNeg;
-
- Test2ReqWidth = 200;
- Test2ReqHeight = 100;
- Test2ReqFlags = ReqDataFlagBackFill+
- ReqDataFlagInnerWindow;
- Test2ReqTitle = " Requester ";
-
- Test2Text1Type = TextDataTypeText;
- Test2Text1Flags = TextDataFlagCenter+TextDataFlagBold;
- Test2Text1LeftEdge = 0;
- Test2Text1TopEdge = 20;
- Test2Text1Text = "Text Line 1";
-
- Test2Text2Type = TextDataTypeText;
- Test2Text2Flags = TextDataFlagCenter+TextDataFlagItalic+
- TextDataFlagColor2;
- Test2Text2LeftEdge = 0;
- Test2Text2TopEdge = Test2Text1TopEdge + 10;
- Test2Text2Text = "Text Line 2";
-
- Test2Text3Type = TextDataTypeText;
- Test2Text3Flags = TextDataFlagCenter+TextDataFlagUnderLined;
- Test2Text3LeftEdge = 0;
- Test2Text3TopEdge = Test2Text2TopEdge + 10;
- Test2Text3Text = "Text Line 3";
-
- Test2Border1Type = BorderDataTypeBox2Out;
- Test2Border1LeftEdge = 20;
- Test2Border1TopEdge = 10;
- Test2Border1Width = Test2ReqWidth-2 * Test2Border1LeftEdge;
- Test2Border1Height = Test2ReqHeight - (3 * Test2Border1TopEdge+19);
- (*Test2Gadget1Height*)
-
- Test2GadgetContinue = 0;
-
- Test2Gadget1Type = GadgetDataTypeButton;
- Test2Gadget1Flags = GadgetDataFlagHotKey+GadgetDataFlagMovePointer;
- Test2Gadget1Width = ((8 + 2) * 10);
- Test2Gadget1Height = 19;
- Test2Gadget1LeftEdge = (Test2ReqWidth - Test2Gadget1Width) DIV 2;
- Test2Gadget1TopEdge = Test2ReqHeight - (Test2Gadget1Height + 10);
- Test2Gadget1Text = "_Continue";
-
- PROCEDURE InitData();
-
- VAR
- defvalue : LONGCARD;
-
- BEGIN
- testnewwindow.LeftEdge := 0;
- testnewwindow.TopEdge := 0;
- testnewwindow.Width := WindowWidth;
- testnewwindow.Height := WindowHeight;
- testnewwindow.DetailPen := BYTE(0);
- testnewwindow.BlockPen := BYTE(1);
- testnewwindow.IDCMPFlags := WindowIDCMPflags;
- testnewwindow.Flags := Windowflags;
- testnewwindow.FirstGadget := NIL;
- testnewwindow.CheckMark := NIL;
- testnewwindow.Title := ADR(WindowTitle);
- testnewwindow.Screen := NIL;
- testnewwindow.BitMap := NIL;
- testnewwindow.MinWidth := 0;
- testnewwindow.MinHeight := 0;
- testnewwindow.MaxWidth := 0;
- testnewwindow.MaxHeight := 0;
- testnewwindow.Type := WBenchScreen;
-
- topaz60attr.taName := ADR("topaz.font");
- topaz60attr.taYSize := TopazSixty;
- topaz60attr.taStyle := NormalFontStyle;
- topaz60attr.taFlags := FontFlagsSet{RomFont};
-
- topaz80attr.taName := ADR("topaz.font");
- topaz80attr.taYSize := TopazEighty;
- topaz80attr.taStyle := NormalFontStyle;
- topaz80attr.taFlags := FontFlagsSet{RomFont};
-
- image1data := AllocMem(32,MemReqSet{MemChip});
-
- image1data^[0] := 0FFFFH; image1data^[1] := 08000H; image1data^[2] := 0BFF0H;
- image1data^[3] := 0A00CH; image1data^[4] := 0A00CH; image1data^[5] := 0BFF0H;
- image1data^[6] := 08000H; image1data^[7] := 08000H; image1data^[8] := 00000H;
- image1data^[9] := 00001H; image1data^[10] := 00005H; image1data^[11] := 01FF1H;
- image1data^[12] := 01FF1H; image1data^[13] := 00005H; image1data^[14] := 00001H;
- image1data^[15] := 07FFFH;
-
- image1.LeftEdge := 0;
- image1.TopEdge := 0;
- image1.Width := 16;
- image1.Height := 8;
- image1.Depth := 2;
- image1.ImageData := image1data;
- image1.PlanePick := BYTE(3);
- image1.PlaneOnOff := BYTE(0);
- image1.NextImage := NIL;
-
- image2data := AllocMem(32,MemReqSet{MemChip});
-
- image2data^[0] := 00000H; image2data^[1] := 0000FH; image2data^[2] := 03FFFH;
- image2data^[3] := 023FDH; image2data^[4] := 03FCDH; image2data^[5] := 07FF1H;
- image2data^[6] := 07001H; image2data^[7] := 07FFFH; image2data^[8] := 0FFFFH;
- image2data^[9] := 0800EH; image2data^[10] := 0807EH; image2data^[11] := 09FF8H;
- image2data^[12] := 09FF0H; image2data^[13] := 0FE04H; image2data^[14] := 0F000H;
- image2data^[15] := 08000H;
-
- image2.LeftEdge := 0;
- image2.TopEdge := 0;
- image2.Width := 16;
- image2.Height := 8;
- image2.Depth := 2;
- image2.ImageData := image2data;
- image2.PlanePick := BYTE(3);
- image2.PlaneOnOff := BYTE(0);
- image2.NextImage := NIL;
-
- mxarray[0] := ADR("Fast File System");
- mxarray[1] := ADR("Old File System");
- mxarray[2] := ADR("Custom FileSystem");
- mxarray[3] := NIL;
-
- textarray[0] := ADR("Amiga");
- textarray[1] := ADR("Workbench");
- textarray[2] := ADR("AmigaDos");
- textarray[3] := ADR("Multitasking");
- textarray[4] := ADR("CLI");
- textarray[5] := ADR("Arexx");
- textarray[6] := ADR("Tex");
- textarray[7] := ADR("Unix");
- textarray[8] := NIL;
-
- testgadgetdata[0].gdType := TestGadget1Type;
- testgadgetdata[0].gdFlags := TestGadget1Flags;
- testgadgetdata[0].gdLeftEdge := TestGadget1LeftEdge;
- testgadgetdata[0].gdTopEdge := TestGadget1TopEdge;
- testgadgetdata[0].gdWidth := TestGadget1Width;
- testgadgetdata[0].gdHeight := TestGadget1Height;
- testgadgetdata[0].gdText := ADR(TestGadget1Text);
- testgadgetdata[0].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[0].gdButtonData.gdButtonSelected := 0D;
- testgadgetdata[0].gdButtonData.gdButtonNormalRender := NIL;
- testgadgetdata[0].gdButtonData.gdButtonSelectRender := NIL;
-
- testgadgetdata[1].gdType := TestGadget2Type;
- testgadgetdata[1].gdFlags := TestGadget2Flags;
- testgadgetdata[1].gdLeftEdge := TestGadget2LeftEdge;
- testgadgetdata[1].gdTopEdge := TestGadget2TopEdge;
- testgadgetdata[1].gdWidth := TestGadget2Width;
- testgadgetdata[1].gdHeight := TestGadget2Height;
- testgadgetdata[1].gdText := ADR(TestGadget2Text);
- testgadgetdata[1].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[1].gdButtonData.gdButtonSelected := 0D;
- testgadgetdata[1].gdButtonData.gdButtonNormalRender := ADR(image1);
- testgadgetdata[1].gdButtonData.gdButtonSelectRender := ADR(image2);
-
- testgadgetdata[2].gdType := TestGadget3Type;
- testgadgetdata[2].gdFlags := TestGadget3Flags;
- testgadgetdata[2].gdLeftEdge := TestGadget3LeftEdge;
- testgadgetdata[2].gdTopEdge := TestGadget3TopEdge;
- testgadgetdata[2].gdWidth := TestGadget3Width;
- testgadgetdata[2].gdHeight := TestGadget3Height;
- testgadgetdata[2].gdText := ADR(TestGadget3Text);
- testgadgetdata[2].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[2].gdCheckData.gdCheckSelected := TestGadget3CheckState;
- testgadgetdata[2].gdCheckData.gdCheckPad1 := 0D;
- testgadgetdata[2].gdCheckData.gdCheckPad2 := 0D;
-
- testgadgetdata[3].gdType := TestGadget4Type;
- testgadgetdata[3].gdFlags := TestGadget4Flags;
- testgadgetdata[3].gdLeftEdge := TestGadget4LeftEdge;
- testgadgetdata[3].gdTopEdge := TestGadget4TopEdge;
- testgadgetdata[3].gdWidth := TestGadget4Width;
- testgadgetdata[3].gdHeight := TestGadget4Height;
- testgadgetdata[3].gdText := ADR(TestGadget4Text);
- testgadgetdata[3].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[3].gdMXData.gdMXSpacing := TestGadget4Spacing;
- testgadgetdata[3].gdMXData.gdMXActiveEntry := TestGadget4Active;
- testgadgetdata[3].gdMXData.gdMXTextArray := ADR(mxarray);
-
- testgadgetdata[4].gdType := TestGadget5Type;
- testgadgetdata[4].gdFlags := TestGadget5Flags;
- testgadgetdata[4].gdLeftEdge := TestGadget5LeftEdge;
- testgadgetdata[4].gdTopEdge := TestGadget5TopEdge;
- testgadgetdata[4].gdWidth := TestGadget5Width;
- testgadgetdata[4].gdHeight := TestGadget5Height;
- testgadgetdata[4].gdText := ADR(TestGadget5Text);
- testgadgetdata[4].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[4].gdInputData.gdInputLen := TestGadget5InputLen;
- testgadgetdata[4].gdInputData.gdInputActiveNext := TestGadget5AutoActive;
- testgadgetdata[4].gdInputData.gdInputActiveNext := TestGadget5AutoActive;
- testgadgetdata[4].gdInputData.gdInputDefault := ADR(TestGadget5InputDefault);
-
- testgadgetdata[5].gdType := TestGadget6Type;
- testgadgetdata[5].gdFlags := TestGadget6Flags;
- testgadgetdata[5].gdLeftEdge := TestGadget6LeftEdge;
- testgadgetdata[5].gdTopEdge := TestGadget6TopEdge;
- testgadgetdata[5].gdWidth := TestGadget6Width;
- testgadgetdata[5].gdHeight := TestGadget6Height;
- testgadgetdata[5].gdText := ADR(TestGadget6Text);
- testgadgetdata[5].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[5].gdInputData.gdInputLen := TestGadget6InputLen;
- testgadgetdata[5].gdInputData.gdInputActiveNext := TestGadget6AutoActive;
- testgadgetdata[5].gdInputData.gdInputActiveNext := TestGadget6AutoActive;
- testgadgetdata[5].gdInputData.gdInputDefault := 123D;
-
- testgadgetdata[6].gdType := TestGadget7Type;
- testgadgetdata[6].gdFlags := TestGadget7Flags;
- testgadgetdata[6].gdLeftEdge := TestGadget7LeftEdge;
- testgadgetdata[6].gdTopEdge := TestGadget7TopEdge;
- testgadgetdata[6].gdWidth := TestGadget7Width;
- testgadgetdata[6].gdHeight := TestGadget7Height;
- testgadgetdata[6].gdText := ADR(TestGadget7Text);
- testgadgetdata[6].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[6].gdSliderData.gdSliderMin := TestGadget7Min;
- testgadgetdata[6].gdSliderData.gdSliderMax := TestGadget7Max;
- testgadgetdata[6].gdSliderData.gdSliderLevel := TestGadget7Level;
-
- testgadgetdata[7].gdType := TestGadget8Type;
- testgadgetdata[7].gdFlags := TestGadget8Flags;
- testgadgetdata[7].gdLeftEdge := TestGadget8LeftEdge;
- testgadgetdata[7].gdTopEdge := TestGadget8TopEdge;
- testgadgetdata[7].gdWidth := TestGadget8Width;
- testgadgetdata[7].gdHeight := TestGadget8Height;
- testgadgetdata[7].gdText := ADR(TestGadget8Text);
- testgadgetdata[7].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[7].gdSliderData.gdSliderMin := TestGadget8Min;
- testgadgetdata[7].gdSliderData.gdSliderMax := TestGadget8Max;
- testgadgetdata[7].gdSliderData.gdSliderLevel := TestGadget8Level;
-
- testgadgetdata[8].gdType := TestGadget9Type;
- testgadgetdata[8].gdFlags := TestGadget9Flags;
- testgadgetdata[8].gdLeftEdge := TestGadget9LeftEdge;
- testgadgetdata[8].gdTopEdge := TestGadget9TopEdge;
- testgadgetdata[8].gdWidth := TestGadget9Width;
- testgadgetdata[8].gdHeight := TestGadget9Height;
- testgadgetdata[8].gdText := ADR(TestGadget9Text);
- testgadgetdata[8].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[8].gdScrollerData.gdScrollerVisible := TestGadget9Visible;
- testgadgetdata[8].gdScrollerData.gdScrollerTotal := TestGadget9Total;
- testgadgetdata[8].gdScrollerData.gdScrollerTop := TestGadget9Top;
-
- testgadgetdata[9].gdType := TestGadget10Type;
- testgadgetdata[9].gdFlags := TestGadget10Flags;
- testgadgetdata[9].gdLeftEdge := TestGadget10LeftEdge;
- testgadgetdata[9].gdTopEdge := TestGadget10TopEdge;
- testgadgetdata[9].gdWidth := TestGadget10Width;
- testgadgetdata[9].gdHeight := TestGadget10Height;
- testgadgetdata[9].gdText := ADR(TestGadget10Text);
- testgadgetdata[9].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[9].gdScrollerData.gdScrollerVisible := TestGadget10Visible;
- testgadgetdata[9].gdScrollerData.gdScrollerTotal := TestGadget10Total;
- testgadgetdata[9].gdScrollerData.gdScrollerTop := TestGadget10Top;
-
- testgadgetdata[10].gdType := TestGadget11Type;
- testgadgetdata[10].gdFlags := TestGadget11Flags;
- testgadgetdata[10].gdLeftEdge := TestGadget11LeftEdge;
- testgadgetdata[10].gdTopEdge := TestGadget11TopEdge;
- testgadgetdata[10].gdWidth := TestGadget11Width;
- testgadgetdata[10].gdHeight := TestGadget11Height;
- testgadgetdata[10].gdText := ADR(TestGadget11Text);
- testgadgetdata[10].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[10].gdCycleData.gdCycleSpacing := 0;
- testgadgetdata[10].gdCycleData.gdCycleActive := TestGadget11Active;
- testgadgetdata[10].gdCycleData.gdCycleTextArray := ADR(textarray);
-
- testgadgetdata[11].gdType := TestGadget12Type;
- testgadgetdata[11].gdFlags := TestGadget12Flags;
- testgadgetdata[11].gdLeftEdge := TestGadget12LeftEdge;
- testgadgetdata[11].gdTopEdge := TestGadget12TopEdge;
- testgadgetdata[11].gdWidth := TestGadget12Width;
- testgadgetdata[11].gdHeight := TestGadget12Height;
- testgadgetdata[11].gdText := ADR(TestGadget12Text);
- testgadgetdata[11].gdTextAttr := ADR(topaz80attr);
- testgadgetdata[11].gdCountData.gdCountMin := TestGadget12Min;
- testgadgetdata[11].gdCountData.gdCountMax := TestGadget12Max;
- testgadgetdata[11].gdCountData.gdCountValue := TestGadget12Value;
-
- testgadgetdata[12].gdType := TestGadget13Type;
- testgadgetdata[12].gdFlags := TestGadget13Flags;
- testgadgetdata[12].gdLeftEdge := TestGadget13LeftEdge;
- testgadgetdata[12].gdTopEdge := TestGadget13TopEdge;
- testgadgetdata[12].gdWidth := TestGadget13Width;
- testgadgetdata[12].gdHeight := TestGadget13Height;
- testgadgetdata[12].gdText := ADR(TestGadget13Text);
- testgadgetdata[12].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[12].gdListViewData.gdListViewSpacing := TestGadget13Spacing;
- testgadgetdata[12].gdListViewData.gdListViewTop := TestGadget13Top;
- testgadgetdata[12].gdListViewData.gdListViewList := ADR(testlist);
-
- testgadgetdata[13].gdType := TestGadget14Type;
- testgadgetdata[13].gdFlags := TestGadget14Flags;
- testgadgetdata[13].gdLeftEdge := TestGadget14LeftEdge;
- testgadgetdata[13].gdTopEdge := TestGadget14TopEdge;
- testgadgetdata[13].gdWidth := TestGadget14Width;
- testgadgetdata[13].gdHeight := TestGadget14Height;
- testgadgetdata[13].gdText := ADR(TestGadget14Text);
- testgadgetdata[13].gdTextAttr := ADR(topaz60attr);
- testgadgetdata[13].gdPaletteData.gdPaletteDepth := TestGadget14Depth;
- testgadgetdata[13].gdPaletteData.gdPaletteColorOffset := TestGadget14ColorOffset;
- testgadgetdata[13].gdPaletteData.gdPaletteActiveColor := TestGadget14ActiveColor;
-
- testgadgetdata[14].gdType := IntuiSupDataEnd;
-
- test2textdata[0].tdType := Test2Text1Type;
- test2textdata[0].tdFlags := Test2Text1Flags;
- test2textdata[0].tdLeftEdge := Test2Text1LeftEdge;
- test2textdata[0].tdTopEdge := Test2Text1TopEdge;
- test2textdata[0].tdText := ADR(Test2Text1Text);
- test2textdata[0].tdTextAttr := ADR(topaz80attr);
-
- test2textdata[1].tdType := Test2Text2Type;
- test2textdata[1].tdFlags := Test2Text2Flags;
- test2textdata[1].tdLeftEdge := Test2Text2LeftEdge;
- test2textdata[1].tdTopEdge := Test2Text2TopEdge;
- test2textdata[1].tdText := ADR(Test2Text2Text);
- test2textdata[1].tdTextAttr := ADR(topaz80attr);
-
- test2textdata[2].tdType := Test2Text3Type;
- test2textdata[2].tdFlags := Test2Text3Flags;
- test2textdata[2].tdLeftEdge := Test2Text3LeftEdge;
- test2textdata[2].tdTopEdge := Test2Text3TopEdge;
- test2textdata[2].tdText := ADR(Test2Text3Text);
- test2textdata[2].tdTextAttr := ADR(topaz80attr);
-
- test2textdata[3].tdType := IntuiSupDataEnd;
-
- test2borderdata[0].bdType := Test2Border1Type;
- test2borderdata[0].bdLeftEdge := Test2Border1LeftEdge;
- test2borderdata[0].bdTopEdge := Test2Border1TopEdge;
- test2borderdata[0].bdWidth := Test2Border1Width;
- test2borderdata[0].bdHeight := Test2Border1Height;
-
- test2borderdata[1].bdType := IntuiSupDataEnd;
-
- test2gadgetdata[0].gdType := Test2Gadget1Type;
- test2gadgetdata[0].gdFlags := Test2Gadget1Flags;
- test2gadgetdata[0].gdLeftEdge := Test2Gadget1LeftEdge;
- test2gadgetdata[0].gdTopEdge := Test2Gadget1TopEdge;
- test2gadgetdata[0].gdWidth := Test2Gadget1Width;
- test2gadgetdata[0].gdHeight := Test2Gadget1Height;
- test2gadgetdata[0].gdText := ADR(Test2Gadget1Text);
- test2gadgetdata[0].gdTextAttr := ADR(topaz80attr);
-
- test2gadgetdata[1].gdType := IntuiSupDataEnd;
-
- test2requesterdata.rdLeftEdge:= 0;
- test2requesterdata.rdTopEdge := 0;
- test2requesterdata.rdWidth := Test2ReqWidth;
- test2requesterdata.rdHeight := Test2ReqHeight;
- test2requesterdata.rdFlags := Test2ReqFlags;
- test2requesterdata.rdTitle := ADR(Test2ReqTitle);
- test2requesterdata.rdTexts := ADR(test2textdata);
- test2requesterdata.rdBorders := ADR(test2borderdata);
- test2requesterdata.rdGadgets := ADR(test2gadgetdata);
-
- testmenudata[0].mdType := MenuDataTypeTitle;
- testmenudata[0].mdFlags := 0;
- testmenudata[0].mdName := ADR("Menu 0");
- testmenudata[0].mdCommandKey := NIL;
- testmenudata[0].mdMutualExclude := 0D;
-
- testmenudata[1].mdType := MenuDataTypeItem;
- testmenudata[1].mdFlags := MenuDataFlagAtributte+MenuDataFlagSelected;
- testmenudata[1].mdName := ADR("Item 0.0");
- testmenudata[1].mdCommandKey := ADR("0");
- testmenudata[1].mdMutualExclude := 0FFFFFFFEH;
-
- testmenudata[2].mdType := MenuDataTypeItem;
- testmenudata[2].mdFlags := MenuDataFlagAtributte;
- testmenudata[2].mdName := ADR("Item 0.1");
- testmenudata[2].mdCommandKey := ADR("1");
- testmenudata[2].mdMutualExclude := 0FFFFFFFDH;
-
- testmenudata[3].mdType := MenuDataTypeItem;
- testmenudata[3].mdFlags := MenuDataFlagHighBox;
- testmenudata[3].mdName := ADR("Item 0.2");
- testmenudata[3].mdCommandKey := NIL;
- testmenudata[3].mdMutualExclude := 0;
-
- testmenudata[4].mdType := MenuDataTypeSubItem;
- testmenudata[4].mdFlags := 0;
- testmenudata[4].mdName := ADR("Item 0.2.0");
- testmenudata[4].mdCommandKey := ADR("A");
- testmenudata[4].mdMutualExclude := 0;
-
- testmenudata[5].mdType := MenuDataTypeSubItem;
- testmenudata[5].mdFlags := 0;
- testmenudata[5].mdName := ADR("Item 0.2.1");
- testmenudata[5].mdCommandKey := ADR("B");
- testmenudata[5].mdMutualExclude := 0;
-
- testmenudata[6].mdType := MenuDataTypeItem;
- testmenudata[6].mdFlags := 0;
- testmenudata[6].mdName := ADR("Item 0.3");
- testmenudata[6].mdCommandKey := NIL;
- testmenudata[6].mdMutualExclude := 0;
-
- testmenudata[7].mdType := MenuDataTypeTitle;
- testmenudata[7].mdFlags := 0;
- testmenudata[7].mdName := ADR("Menu1");
- testmenudata[7].mdCommandKey := NIL;
- testmenudata[7].mdMutualExclude := 0;
-
- testmenudata[8].mdType := MenuDataTypeItem;
- testmenudata[8].mdFlags := MenuDataFlagHighBox;
- testmenudata[8].mdName := ADR("Item 1.0");
- testmenudata[8].mdCommandKey := ADR("C");
- testmenudata[8].mdMutualExclude := 0;
-
- testmenudata[9].mdType := MenuDataTypeItem;
- testmenudata[9].mdFlags := MenuDataFlagEmptyLine;
- testmenudata[9].mdName := ADR("Item 1.1");
- testmenudata[9].mdCommandKey := ADR("D");
- testmenudata[9].mdMutualExclude := 0;
-
- testmenudata[10].mdType := MenuDataTypeItem;
- testmenudata[10].mdFlags := 0;
- testmenudata[10].mdName := ADR("Item 1.2");
- testmenudata[10].mdCommandKey := NIL;
- testmenudata[10].mdMutualExclude := 0;
-
- testmenudata[11].mdType := MenuDataTypeSubItem;
- testmenudata[11].mdFlags := 0;
- testmenudata[11].mdName := ADR("Item 1.2.0");
- testmenudata[11].mdCommandKey := ADR("E");
- testmenudata[11].mdMutualExclude := 0;
-
- testmenudata[12].mdType := MenuDataTypeSubItem;
- testmenudata[12].mdFlags := 0;
- testmenudata[12].mdName := ADR("Item 1.2.1");
- testmenudata[12].mdCommandKey := ADR("F");
- testmenudata[12].mdMutualExclude := 0;
-
- testmenudata[13].mdType := MenuDataTypeItem;
- testmenudata[13].mdFlags := 0;
- testmenudata[13].mdName := ADR("Item 1.3");
- testmenudata[13].mdCommandKey := NIL;
- testmenudata[13].mdMutualExclude := 0;
-
- testmenudata[14].mdType := MenuDataTypeSubItem;
- testmenudata[14].mdFlags := 0;
- testmenudata[14].mdName := ADR("Item 1.3.0");
- testmenudata[14].mdCommandKey := ADR("G");
- testmenudata[14].mdMutualExclude := 0;
-
- testmenudata[15].mdType := MenuDataTypeItem;
- testmenudata[15].mdFlags := MenuDataFlagEmptyLine;
- testmenudata[15].mdName := ADR("Item 1.3.1");
- testmenudata[15].mdCommandKey := ADR("H");
- testmenudata[15].mdMutualExclude := 0;
-
- testmenudata[16].mdType := MenuDataTypeItem;
- testmenudata[16].mdFlags := 0;
- testmenudata[16].mdName := ADR("Item 1.4");
- testmenudata[16].mdCommandKey := ADR("I");
- testmenudata[16].mdMutualExclude := 0;
-
- testmenudata[17].mdType := IntuiSupDataEnd;
- END InitData;
-
- PROCEDURE FreeData();
-
- BEGIN
- FreeMem(image1data,32);
- FreeMem(image2data,32);
- END FreeData;
-
- PROCEDURE freetestlist();
-
- VAR
- list:ListPtr;
- node:NodePtr;
- quit:BOOLEAN;
-
- BEGIN
- list := ADR(testlist);
- quit := FALSE;
- WHILE (~quit) DO
- node := RemHead(list^);
- IF (node # NIL) THEN
- FreeMem(node,TSIZE(Node))
- ELSE
- quit := TRUE
- END
- END
- END freetestlist;
-
- PROCEDURE buildtestlist():BOOLEAN;
-
- VAR
- list:ListPtr;
- node:NodePtr;
- success,break:BOOLEAN;
- i:CARDINAL;
-
- BEGIN
- list := ADR(testlist);
- success := TRUE;
- break := FALSE;
- i := 0;
-
- NewList(list^);
- WHILE ((i < 8) & ~(break)) DO
- node := AllocMem(TSIZE(Node),MemReqSet{MemPublic,MemClear});
- IF (node # NIL) THEN
- node^.lnName := textarray[i];
- INC(i);
- AddTail(list^,node^)
- ELSE
- freetestlist();
- success := FALSE;
- break := TRUE;
- END
- END;
- RETURN success
- END buildtestlist;
-
- PROCEDURE testaction(ri:ADDRESS; win:WindowPtr; gl,ml:ADDRESS);
-
- VAR
- rp:RastPortPtr;
- up:MsgPortPtr;
- msg2,msg1:IntuiMessagePtr;
- rl,format:ADDRESS;
- buffer:ARRAY [0..80] OF CHAR;
- code:CARDINAL;
- input:BOOLEAN;
- keepon2,keepon1:BOOLEAN;
- dummy:ADDRESS;
- dummy2:LONGCARD;
- menuitem:MenuItemPtr;
- args:ARRAY[0..9] OF FormatArg;
- count,count1,count2:CARDINAL;
-
- BEGIN
- rp := win^.RPort;
- up := win^.UserPort;
- input := TRUE;
- keepon2 := TRUE;
- WHILE (keepon2) DO
- dummy := WaitPort(up^);
- msg2 := IGetMsg(up);
- IF (msg2 # NIL) THEN
- code := msg2^.Code;
- IF (Closewindow IN msg2^.Class) THEN
- keepon2 := FALSE
- ELSIF (LONGCARD(msg2^.Class) = ISupID) THEN
- IF (code = TestGadgetString) THEN
- format := ADR(MessageText1)
- ELSE
- format := ADR(MessageText2)
- END;
- args[0].W := code;
- args[1].L := msg2^.IAddress;
- count := sprintf(ADR(buffer),format,args);
-
- IClearRenderWindow(ri,win,MessageLeftEdge, MessageTopEdge,
- MessageLeftEdge+MessageWidth-1,
- MessageTopEdge+MessageHeight-1,0);
- count := IPrintText(ri,win,ADR(buffer),0,MessageTopEdge,
- TextDataTypeText,TextDataFlagCenter+TextDataFlagColor2,
- ADR(topaz80attr));
- CASE code OF
- TestGadgetCheck:
- IF (msg2^.IAddress # NIL) THEN
- dummy2 := ISetGadgetAttributes(gl,TestGadgetListView,
- GadgetDataFlagDisabled,0D,
- UseCurrentValue,LONGCARD(TestGadget13Top),ADR(testlist))
- ELSE
- dummy2 := ISetGadgetAttributes(gl,TestGadgetListView,
- GadgetDataFlagDisabled,GadgetDataFlagDisabled,
- UseCurrentValue,UseCurrentValue,NIL)
- END |
- TestGadgetButton:
- IF (~input) THEN
- dummy2 := ISetGadgetAttributes(gl,TestGadgetInteger,
- GadgetDataFlagDisabled,0D,
- UseCurrentValue,UseCurrentValue,UseCurrentValue);
- input := TRUE
- ELSE
- dummy2 := ISetGadgetAttributes(gl,TestGadgetInteger,
- GadgetDataFlagDisabled,GadgetDataFlagDisabled,
- UseCurrentValue,UseCurrentValue,UseCurrentValue);
- input := FALSE
- END |
- TestGadgetButtonImage:
- IF (msg2^.IAddress # NIL) THEN
- input := IAutoRequest(win,ADR(Test1AutoReqTitle),
- ADR(Test1AutoReqBodyText),
- ADR(Test1AutoReqPosText), ADR(Test1AutoReqNegText),
- IDCMPFlagsSet{},IDCMPFlagsSet{},
- Test1AutoReqFlags, NIL)
- ELSE
- rl := IDisplayRequester(win,ADR(test2requesterdata),NIL);
- IF (rl # NIL) THEN
- keepon1 := TRUE;
- WHILE (keepon1) DO
- dummy := WaitPort(up^);
- msg1 := IGetMsg(up);
- IF (msg1 # NIL) THEN
- IF (LONGCARD(msg1^.Class) = ISupID) THEN
- keepon1 := FALSE
- END;
- IReplyMsg(msg1)
- END
- END;
- IRemoveRequester(rl);
- END
- END
- END (* case *)
-
- ELSIF (MenuPick IN msg2^.Class) THEN
- WHILE (code # MenuNull) DO
- count := MENUNUM(code);
- IF (count = NoMenu) THEN count := 0 END;
- count1 := ITEMNUM(code);
- IF (count1 = NoItem) THEN count1 := 0 END;
- count2 := SUBNUM(code);
- IF (count2 = NoSub) THEN count2 := 0 END;
- args[0].W := count;
- args[1].W := count1;
- args[2].W := count2;
- count := sprintf(ADR(buffer),ADR(MessageText3),args);
- IClearRenderWindow(ri,win,
- MessageLeftEdge,
- MessageTopEdge,
- MessageLeftEdge+MessageWidth-1,
- MessageTopEdge+MessageHeight-1,0);
- count := IPrintText(ri,win,ADR(buffer),0,MessageTopEdge,
- TextDataTypeText,TextDataFlagCenter+TextDataFlagColor2,
- ADR(topaz80attr));
- menuitem := IMenuItemAddress(ml,code);
- code := menuitem^.NextSelect;
- END
- END;
- IReplyMsg(msg2)
- END
- END
- END testaction;
-
- VAR
- gl,ml,ri:ADDRESS;
- win:WindowPtr;
- gd:GadgetPtr;
- dummy:ADDRESS;
-
- BEGIN
- IntuiSupBase := OpenLibrary(ADR("intuisup.library"),3);
- IF (IntuiSupBase # NIL) THEN
- InitData();
- IF (buildtestlist()) THEN
- ri := IGetRenderInfo(NIL,RenderInfoFlags);
- IF (ri # NIL) THEN
- win := IOpenWindow(ri,testnewwindow,OpenWindowFlags);
- IF (win # NIL) THEN
- testgadgetdata[TestGadgetButtonImage].gdButtonData.gdButtonNormalRender := ADR(image1);
- gl := ICreateGadgets(ri,ADR(testgadgetdata),0,0,NIL);
- IF (gl # NIL) THEN
- ml := ICreateMenu(ri,win,ADR(testmenudata),ADR(topaz60attr),NIL);
- IF (ml # NIL) THEN
- IDisplayGadgets(win,gl);
- IAttachMenu(win,ml);
- testaction(ri,win,gl,ml);
- dummy := IRemoveMenu(ml);
- dummy := IRemoveGadgets(gl);
- IFreeMenu(ml)
- ELSE
- END;
- IFreeGadgets(gl)
- ELSE
- END;
- CloseWindow(win^);
- ELSE
- END;
- IFreeRenderInfo(ri)
- ELSE
- END;
- freetestlist()
- ELSE
- END;
- FreeData();
- CloseLibrary(IntuiSupBase^);
- IntuiSupBase := NIL;
- ELSE
- END;
- END Test.
-
-